(FILECREATED " 3-JUL-75 15:00:37" <LENAT>UTIL4.;1 13410  )


  (LISPXPRINT (QUOTE UTIL4COMS)
	      T T)
  [RPAQQ UTIL4COMS
	 ((FNS ACCEPT-B AM-BT CHANGE-B CONDENSEB ED-1F ED-1P ED-1V ED-ALL ED-ALLF ED-ALLP ED-ALLV FORGOT-ANY GLOB 
	       INIT-MAC INIT2 LISTF LISTFILES1 MAPB MAPP MCON MTOP NEW-VERSION NFACET NFUN RESTORE-EXPR SAVE SHOWP 
	       TRANFUN UPCASE XEQ-CLEAN)
	  BB GLOBALVARS REPR-FNS SAVECOMS STICKY-B STICKY-P SYS-FORGET-LIST UCASELST VERSION (P (INIT-MAC))
	  (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
										(NLAML MTOP MAPP MAPB]
(DEFINEQ

(ACCEPT-B
  [LAMBDA (B SIM)
    (CREATEB B)
    (TERPRI)
    [COND
      ((FMEMB SIM CONCEPTS))
      ((PRIN1 "NAME OF SIMILAR BEING... ")
	(SETQ SIM (RATOM]
    (TERPRI)
    (SET B (COPY (GETTOPVAL SIM)))
    (SETPROPLIST B (COPY (GETPROPLIST SIM)))
    (ERRORSET (LIST (QUOTE EDITV)
		    B
		    (LIST (QUOTE RC)
			  SIM B)))
    (ERRORSET (LIST (QUOTE EDITV)
		    B))
    (ERRORSET (LIST (QUOTE EDITP)
		    B
		    (LIST (QUOTE RC)
			  SIM B)))
    (ERRORSET (LIST (QUOTE EDITP)
		    B))
    (DEFB B)
    (PRIN1 "THE NUMBER OF CONCEPTS IS NOW ")
    (PRINT (LENGTH CONCEPTS))
    B])

(AM-BT
  [LAMBDA (V1)
    (MAPDL (FUNCTION (LAMBDA (DX)
	       (COND
		 ((OR (FMEMB DX (CAR TOP4COMS))
		      (FMEMB DX (CAR UTIL4COMS))
		      (FMEMB DX CONCEPTS))
		   (PRIN1 DX)
		   (COND
		     ((SETQ V1 (VARIABLES MAPDLPOS))
		       (TERPRI)
		       (PRIN1 "   ")
		       (PRINT V1)
		       (PRIN1 "   ")
		       (PRINT (STKARGS MAPDLPOS)))
		     ((PRIN1 "  ---NO ARGS")
		       (TERPRI])

(CHANGE-B
  [LAMBDA (B P CP)
    [COND
      ((OR (FMEMB B FACETS)
	   (FMEMB B AUX-FACETS))
	(SETQ P B)
	(PRINT (SETQ B STICKY-B)))
      [(GETHASH B HCON)
	(OR (FMEMB P FACETS)
	    (FMEMB P AUX-FACETS)
	    (PRINT (SETQ P STICKY-P]
      (B (TERPRI)
	 (PRIN1 "***** CANT UNDERSTAND THIS *****")
	 (HELP))
      (T (PRINT (SETQ B STICKY-B))
	 (PRINT (SETQ P STICKY-P]
    (SETQ STICKY-B B)
    (SETQ STICKY-P P)
    (OR (GETB B P)
	(INIT-PART B P))
    (ERRORSET (LIST (QUOTE EDITP)
		    B
		    (QUOTE F)
		    P
		    (QUOTE P)
		    (QUOTE TTY:)))
    (DEFB B)
    (TERPRI)
    (PRIN1 B)
    (PRIN1 COMMA)
    (PRINT P])

(CONDENSEB
  [LAMBDA (CONFILE)
    (SETQ DFNFLG NIL)
    (MAPC NEW-PARTS (QUOTE RESTORE-EXPR))
    (SETQ VERSION (ADD1 VERSION))
    (SETQ CONFILE (PACK (LIST (QUOTE CON)
			      VERSION)))
    (SET (PACK (LIST CONFILE (QUOTE COMS)))
	 (CONS (CONS (QUOTE FNS)
		     NEW-PARTS)
	       NEW-CONCEPTS))
    (MAKEFILE CONFILE (QUOTE C))
    (NCONC (DREMOVE (QUOTE DUMMY)
		    NEW-CONCEPTS)
	   CONCEPTS)
    (SETQ NEW-CONCEPTS (LIST (QUOTE DUMMY)))
    (SETQ NEW-PARTS NIL)
    (SETQ NEW-C-PARTS NIL])

(ED-1F
  [LAMBDA (F1)
    (AND (ERRORSET (CONS (QUOTE EDITF)
			 (CONS F1 ECMS)))
	 (PRIN1 F1)
	 (PRIN1 "  "])

(ED-1P
  [LAMBDA (P1)
    (AND (CDR P1)
	 (ERRORSET (CONS (QUOTE EDITP)
			 (CONS P1 ECMS)))
	 (PRIN1 P1)
	 (PRIN1 "  "])

(ED-1V
  [LAMBDA (V1)
    (AND (LITATOM V1)
	 (OR (NEQ (QUOTE NOBIND)
		  (GETTOPVAL V1))
	     (CPRIN1 2 " WARNING: THE VARIABLE " V1 " IS UNBOUND. " CRLF))
	 (ERRORSET (CONS (QUOTE EDITV)
			 (CONS V1 ECMS)))
	 (PRIN1 V1)
	 (PRIN1 "  "])

(ED-ALL
  [LAMBDA (EECMS)
    (SETQ ECMS EECMS)
    (ED-ALLF)
    (ED-ALLV)
    (ED-ALLP])

(ED-ALLF
  [LAMBDA NIL
    (MAPC (CDAR TOP4COMS)
	  (QUOTE ED-1F))
    (MAPC CONCEPTS (QUOTE ED-1F))
    (MAPC FACETS (QUOTE ED-1F))
    (MAPC (CDADR TOP4COMS)
	  (QUOTE ED-1F))
    (MAPC (CDAR CON4COMS)
	  (QUOTE ED-1F))
    (MAPC (CDAR UTIL4COMS)
	  (QUOTE ED-1F])

(ED-ALLP
  [LAMBDA NIL
    (MAPC CONCEPTS (QUOTE ED-1P])

(ED-ALLV
  [LAMBDA NIL
    (MAPC TOP4COMS (QUOTE ED-1V))
    (MAPC CON4COMS (QUOTE ED-1V))
    (MAPC UTIL4COMS (QUOTE ED-1V))
    (MAPC CONCEPTS (QUOTE ED-1V))
    (MAPC FACETS (QUOTE ED-1V])

(FORGOT-ANY
  [LAMBDA (FF)
    (TERPRI)
    (PRIN1 "MAYBE YOU FORGOT SOME OF THESE: ")
    [MAPATOMS (FUNCTION (LAMBDA (X)
		  (AND (EXPRP X)
		       (NOT (MEMB X (CAR TOP4COMS)))
		       (NOT (MEMB X (CADR TOP4COMS)))
		       (NOT (MEMB X (CAR UTIL4COMS)))
		       (NOT (MEMB X CONCEPTS))
		       (NOT (MEMB X SYS-FORGET-LIST))
		       (NOT (MEMB X FACETS))
		       [NOT (MATCH (UNPACK X) WITH (X1←--@[LAMBDA (Z)
						       (GETHASH Z HCON]
						     '- X2←--@(LAMBDA (Z)
						       (MEMB Z FACETS]
		       (NOT (MEMB X (CAR CON4COMS)))
		       (NOT (MATCH (UNPACK X) WITH (-- '- 'E '- --)))
		       (NOT (MATCH (UNPACK X) WITH (-- 'B &@NUMBERP &@NUMBERP &@NUMBERP &@NUMBERP)))
		       (PRIN1 X)
		       (PRIN1 (QUOTE % % ))
		       (SETQ FF T]
    (COND
      (FF (TERPRI)
	  (PRINT (QUOTE THINK!!!)))
      (T (PRIN1 "  NEVER MIND. ")))
    (TERPRI])

(GLOB
  [LAMBDA (GV)
    [COND
      ((AND GV (NLISTP GV))
	(SETQ GV (LIST GV]
    (MERGE (SORT GV)
	   GLOBALVARS)
    (SETQ GLOBALVARS (INTERSECTION GLOBALVARS GLOBALVARS))
    (PRIN1 " THE NUMBER OF GLOBAL VARAIABLES IS NOW ")
    (PRINT (LENGTH GLOBALVARS])

(INIT-MAC
  [LAMBDA NIL
    (DEFLIST [QUOTE ((FGETB ((B P)
			     (GETP B P)))
		     [GETB (X (COND
				((EQ (CAADR X)
				     (QUOTE QUOTE))
				  (SELECTQ (CADADR X)
					   ((EXS EXS-BDY EXS-NOT EXS-NOT-BDY)
					     (LIST (QUOTE CDDR)
						   (CONS (QUOTE GETP)
							 X)))
					   (CONS (QUOTE GETP)
						 X)))
				(T (LIST (QUOTE SELECTQ)
					 (LIST (QUOTE SETQ)
					       (QUOTE PMAC)
					       (CADR X))
					 [LIST (QUOTE (EXS EXS-NOT EXS-BDY EXS-NOT-BDY))
					       (LIST (QUOTE CDDR)
						     (LIST (QUOTE GETP)
							   (CAR X)
							   (QUOTE PMAC]
					 (LIST (QUOTE GETP)
					       (CAR X)
					       (QUOTE PMAC]
		     (GETBQ ((B P)
			     (GETP (QUOTE B)
				   P)))
		     (SETBQ ((B P Q)
			     (PUT (QUOTE B)
				  (QUOTE P)
				  Q)))
		     (APPLYB (X (CONS (QUOTE APPLY*)
				      X)))
		     (CSINT ((X)
			     (CAAR X)))
		     (CSOTHERS ((X)
				(CDR X)))
		     (CSBEST ((X)
			      (CAR X)))
		     (CINT ((X)
			    (CAR X)))
		     (PINT ((X)
			    (CAR X)))
		     (P-OP ((X)
			    (CADR X)))
		     (P-B ((X)
			   (CADDR X)))
		     (P-P ((X)
			   (CADDDR X)))
		     (COP ((X)
			   (CADR X)))
		     (CB ((X)
			  (CADDR X)))
		     (CP ((X)
			  (CADDDR X)))
		     (CACT ((X)
			    (CDR X)))
		     [BPFS ((X)
			    (CDDR (CADDR (GETD X]
		     (IPRED ((X)
			     (CAR X)))
		     (IDEF ((X)
			    (CADR X)))
		     (IVAL ((X)
			    (CADDR X)))
		     (IFEATURES ((X)
				 (CDDR X)))
		     (IFEA ((X)
			    (CADR X)))
		     [TYPE (X (CAR (LAST X]
		     (ANY-OF (X (CONS (QUOTE OR)
				      X)))
		     [ANY1OF (X (PROGN                                          (* RAND-MEMB X)
				       (CAR X]
		     (ALL-OF (X (CONS (QUOTE APPEND)
				      X]
	     (QUOTE MACRO])

(INIT2
  [LAMBDA NIL
    (SETQ DFNFLG T)
    (SETQ LISPXHISTORY)
    (SETQ EDITHISTORY])

(LISTF
  [LAMBDA NIL
    (TENEX "FTP
SAIL
LOG AM,DBL MER
SEND TOP4≠
TOP4
SEND CON4≠
CON4
SEND UTIL4≠
UTIL4
QUIT
"])

(LISTFILES1
  [LAMBDA (X)
    [COND
      ((NULL X)
	(TERPRI)
	(PRIN1 "NO MORE FILES TO LIST JUST NOW ")
	(TERPRI))
      ((LISTP X)
	(SETQ X (CAR X]
    (TERPRI)
    (SETQ X (UNPACK X))
    [SETQ X (PACK (LDIFF X (MEMB (QUOTE ;)
				 X]
    (TERPRI)
    (PRIN1 (CONCAT "SHOULD I FTP THE FILE " X " OVER TO SAIL? (Y,N)..."))
    (COND
      ((EQ (RATOM)
	   (QUOTE Y))
	(TENEX (CONCAT "FTP
SAIL
LOG AM,DBL MER
SEND " X "≠
" X "
QUIT
"])

(MAPB
  [NLAMBDA (F)
    (MAPC CONCEPTS (LIST (QUOTE LAMBDA)
			 (LIST (QUOTE B))
			 F])

(MAPP
  [NLAMBDA (F)
    (MAPC FACETS (LIST (QUOTE LAMBDA)
		       (LIST (QUOTE P))
		       F])

(MCON
  [LAMBDA NIL
    (SETQ CONCEPTS (SORT (COPY CONCEPTS)))
    (FORGOT-ANY)
    (MAKEFILE (QUOTE CON4)
	      (QUOTE RC])

(MTOP
  [NLAMBDA (X)
    [RPLACA TOP4COMS (CONS (QUOTE FNS)
			   (MERGE X (CDAR TOP4COMS]
    (FORGOT-ANY)
    (MAKEFILE (QUOTE TOP4)
	      (QUOTE RC])

(NEW-VERSION
  [LAMBDA (NAME VNEW V OLD NEW)
    [COND
      (V)
      ((PROG1 (SETQ V VERSION)
	      (SETQ VERSION (ADD1 VERSION]
    (SETQ OLD (PACK (LIST NAME V)))
    [SETQ NEW (PACK (LIST NAME (OR VNEW (ADD1 V]
    [NLSETQ (SET (PACK (LIST NEW (QUOTE COMS)))
		 (EVAL (PACK (LIST OLD (QUOTE COMS]
    (PRIN1 (CONCAT "OLD: " OLD ", NEW: " NEW ", V:" V ", ECMS: " (QUOTE REPLACEMENT)))
    (ED-ALL (LIST (QUOTE RC) OLD NEW])

(NFACET
  [LAMBDA (F XEQ-FLAG SUF-FLAG)
    [COND
      ((ATOM F)
	(SETQ F (LIST F]
    [MAPC F (FUNCTION (LAMBDA (F1)
	      (PUT F1 (QUOTE ARGS)
		   (LIST (QUOTE BA1)
			 (QUOTE BA2)
			 (QUOTE BA3)
			 (QUOTE BA4)))
	      (COND
		(XEQ-FLAG (ATTACH F1 XEQ-PARTS)
			  (ATTACH F1 XS-PARTS)))
	      (COND
		(SUF-FLAG (ATTACH F1 SUF-PARTS)))
	      (DEFP F1)
	      (SETQ GTEMP1 (GLUE (QUOTE ANYB)
				 F1))
	      (COND
		((NOT (GETHASH GTEMP1 HCON))
		  (CREATEB GTEMP1)
		  (SET GTEMP1 NIL)
		  (PUTU GTEMP1 (QUOTE FROM-FILE)
			(QUOTE CON4))
		  (SETB GTEMP1 (QUOTE GENL)
			(LIST (QUOTE ANYB-ANYP]
    (SETQ FACETS (SORT (UNION F FACETS)))
    (PRIN1 "  THE NUMBER OF FACETS IS NOW ")
    (PRINT (LENGTH FACETS])

(NFUN
  [LAMBDA (FUNC FIL)
    [COND
      ((NULL FIL)
	(SETQ FIL (QUOTE TOP4]
    [SETQ FIL (PACK (LIST FIL (QUOTE COMS]
    [RPLACA (EVAL FIL)
	    (CONS (QUOTE FNS)
		  (SORT (UNION FUNC (CDAR (EVAL FIL]
    (PRIN1 " THERE ARE NOW ")
    [PRIN1 (LENGTH (CAR (EVAL FIL]
    (PRIN1 " FUNCTIONS ON ")
    (PRINT FIL])

(RESTORE-EXPR
  [LAMBDA (BPNAME)
    (UNSAVEDEF BPNAME (QUOTE EXPR])

(SAVE
  [LAMBDA NIL
    (MAKEFILE (QUOTE SAVE])

(SHOWP
  [LAMBDA (P)
    (SETQ GTEMP6 NIL)
    (MAPB (AND (GETB B P)
	       (PRINT B)
	       (PRINT (GETB B P))
	       (SETQ GTEMP6 (NCONC1 GTEMP6 B))
	       (TERPRI)))
    (PRIN1 " GTEMP6 = ")
    GTEMP6])

(TRANFUN
  [LAMBDA (F FIL1 FIL2 F1COMS F2COMS)
    [COND
      ((ATOM F)
	(SETQ F (LIST F]
    [SETQ F1COMS (PACK (LIST FIL1 (QUOTE COMS]
    [SETQ F2COMS (PACK (LIST FIL2 (QUOTE COMS]
    [COND
      ((NLISTP (CAR F2COMS))
	(PRIN1 " INITIALIZATION IS REQUIRED ")
	(TERPRI)
	(SET F2COMS (CONS (LIST (QUOTE FNS)
				(QUOTE DUMMY))
			  (COPY (CDR (EVAL F1COMS]
    (COND
      ((NLISTP (CAR F1COMS))
	(HELP "FIRST FILE'S COMS IS NULL ")))
    (SETQ F (SORT F))
    (MERGE (COPY F)
	   (CDAR (EVAL F2COMS)))
    (DREMOVE (QUOTE DUMMY)
	     (CAR (EVAL F2COMS)))
    (MAPC F (FUNCTION (LAMBDA (F1)
	      (DREMOVE F1 (CAR (EVAL F1COMS])

(UPCASE
  [LAMBDA NIL
    (SETQ UCASELST (NCONC (SUBSET TOP4COMS (QUOTE ATOM))
			  (SUBSET CON4COMS (QUOTE ATOM])

(XEQ-CLEAN
  [LAMBDA (B B1 B2 B3)
    (MATCH (DREVERSE (UNPACK B)) WITH (B2←$
					(QUOTE -)
					B1←$))
    (SETQ B1 (PACK (DREVERSE B1)))
    (SETQ B2 (PACK (DREVERSE B2)))
    (AND (FMEMB B2 FACETS)
	 (GETHASH B1 HCON)
	 NIL)                                                                   (* NOTNEEDED APPARENTLY.
										PERHAPS: in the function CREATEB)
    ])
)
  (RPAQQ BB
	 (SET-STRUC-DELETE-E-INV STRUCTURE-MEMB STRUCTURE-INSERT RAND-MEMB SET-STRUC-DELETE OSET-STRUC INSTAN-PAT 
				 INSTAN-REC INSTAN-BASE INSTAN-S INSTAN-D INSTAN-I INSTAN-1D INSTAN-1I INSTAN-1S 
				 PICK-CAND XEQ-CAND UPDATE TLOOP GENL FILLIN PXEQ PGET APPLYB-P GETB-P-C RIPPLE-SIMULT 
				 PSUF EXS RAND-THING))
  (RPAQQ GLOBALVARS
	 (ALLOP ARGS AUX-FACETS B-DEF CAND CAND-TAIL CANDS CIRC COMMA CON4COMS CONCEPTS CONSTRUCTIVE-OPS CRLF CS-ACT 
		CS-B CS-INT CS-OP CS-P CVAL DO-THRESH ECMS EX-THRESH F-COUNTER FACETS FROB FROB1 GATH-PART GEXISTING 
		GLEN GPGM GPNAME GTEMP GTEMP1 GTEMP10 GTEMP11 GTEMP2 GTEMP3 GTEMP4 GTEMP5 GTEMP6 GTEMP7 GTEMP9 
		GXTR-PART HCON ILEV INIT-CANDS INIT-DOTHRESH INIT-EXTHRESH INIT-INTHRESH INIT-ONCE-LIST INIT-PAST 
		INTHRESH JTRASH NEW-C-PARTS NEW-CANDS NEW-CONCEPTS NEW-ILEV NEW-PARTS NEWB NOSWAP-CONCEPTS OBJX 
		ONCE-LIST OR-PARTS PAST PHIST PKNT PMAC PREC RANC RANDSTATE RANF RANU RB1 RTEM2 STICKY-B STICKY-P STRAT 
		STRATEGY-PARTS SUF-PARTS SUF1 SUF2 SWSUF SYS-FORGET-LIST TOP-ACTS TOP4COMS TRIV-B TRIVB USERNAMES 
		UTIL4COMS VERBOSITY VERSION XEQ-PARTS XS-PARTS))
  (RPAQQ REPR-FNS
	 (ACCEPT-B APPLYB BPFS CHANGE-B CREATEB DECRB DEFB DEFP DWIMUSERFN GCB GETB GETBQ GETU GLUE GLUEE INCRB 
		   INIT-PART PGET PSUF PUTB PUTU PXEQ SETB SETBQ SWAPB SWGETB SWSETB))
  (RPAQQ SAVECOMS (PAST CANDS DO-THRESH INTHRESH EXTHRESH RANDSTATE ILEV PHIST ONCE-LIST PKNT RANU RANC OBJX))
  (RPAQQ STICKY-B STRUCTURE-INSERT)
  (RPAQQ STICKY-P ALGS)
  (RPAQQ SYS-FORGET-LIST (DISPLAYTERMP PRETTYCOMPRINT PACK-IN-COMPBLOCK MAKESYS OBIN FGETP OSIN SYSOUT OSFBSZ PUTDQ 
				       /SETPROPLIST SETTOPVAL /SETTOPVAL SETPROPLIST SETFILEPTR))
  (RPAQQ UCASELST
	 (CAND-TAIL COMMA CONSTRUCTIVE-OPS CRLF DO-THRESH DWIMUSERFN EX-THRESH F-COUNTER INIT-CANDS INIT-ONCE-LIST 
		    INIT-PAST INIT-DOTHRESH INIT-EXTHRESH INIT-INTHRESH INTHRESH JTRASH RANDSTATE TOP-ACTS TRIVB 
		    USERNAMES VERBOSITY CONCEPTS FACETS AUX-FACETS SUF-PARTS XEQ-PARTS XS-PARTS))
  (RPAQQ VERSION 4)
  (INIT-MAC)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
  (ADDTOVAR NLAMA)
  (ADDTOVAR NLAML MTOP MAPP MAPB)
]
(DECLARE: DONTCOPY
  (FILEMAP (NIL (602 11221 (ACCEPT-B 614 . 1232) (AM-BT 1236 . 1656) (CHANGE-B 1660 . 2316) (CONDENSEB 2320 . 2837)
(ED-1F 2841 . 2956) (ED-1P 2960 . 3087) (ED-1V 3091 . 3339) (ED-ALL 3343 . 3438) (ED-ALLF 3442 . 3719) (ED-ALLP 3723
. 3781) (ED-ALLV 3785 . 3982) (FORGOT-ANY 3986 . 4883) (GLOB 4887 . 5157) (INIT-MAC 5161 . 6984) (INIT2 6988 . 7080)
(LISTF 7084 . 7211) (LISTFILES1 7215 . 7675) (MAPB 7679 . 7772) (MAPP 7776 . 7877) (MCON 7881 . 8011) (MTOP 8015 .
8174) (NEW-VERSION 8178 . 8617) (NFACET 8621 . 9369) (NFUN 9373 . 9702) (RESTORE-EXPR 9706 . 9776) (SAVE 9780 . 9829)
(SHOWP 9833 . 10052) (TRANFUN 10056 . 10712) (UPCASE 10716 . 10833) (XEQ-CLEAN 10837 . 11218)))))
STOP